home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1995 June: Reference Library / Dev.CD Jun 95 / Dev.CD Jun 95.toast / Technical Documentation / PCI Information / PCI Developer’s Kit (disk) / Open Firmware / SCSI example / scsitape.of < prev   
Encoding:
Text File  |  1994-06-27  |  9.3 KB  |  302 lines  |  [TEXT/EDIT]
  1. \ SCSI tape package implementing a "byte" device-type interface.
  2. \ Supports both fixed-length-record and variable-length-record tape devices.
  3.  
  4. " st" xdrstring " name" attribute
  5. " byte"      device-type
  6.  
  7. fload scsicom.fth        \ Utility routines for SCSI commands
  8.  
  9. hex
  10.  
  11. external
  12.  
  13. false instance value at-eof?      \ Turned on when read-blocks hits file mark
  14.  
  15. headers
  16.  
  17. false instance value fixed-len?   \ True if the device has fixed-length blocks
  18. false instance value written?     \ True if the tape has been written
  19.  
  20. 0 instance value /tapeblock       \ Max length for variable-length records,
  21.                                   \ actual length for fixed length records.
  22.  
  23.  
  24. create write-eof-cmd   h# 10 c, 1 c, 0 c, 0 c, 1 c, 0 c,
  25.  
  26. external
  27.  
  28. \ Writes a file mark
  29.  
  30. : write-eof  ( -- error? )  write-eof-cmd no-data-command  ;
  31.  
  32. headers
  33.  
  34.  
  35. \ Writes a file mark it the tape has been written since the last seek
  36. \ or rewind or write-eof.
  37.  
  38. : ?write-eof  ( -- )
  39.    written?  if
  40.       false is written?
  41.       write-eof  if  ." Can't write file mark." cr  then
  42.    then
  43. ;
  44.  
  45. create rewind-cmd  1 c, 1 c, 0 c, 0 c, 0 c, 0 c,
  46.  
  47. : rewind   ( -- error? )        \ Rewinds the tape
  48.    ?write-eof
  49.    false is at-eof?
  50.    rewind-cmd no-data-command
  51. ;
  52.  
  53. create skip-files-cmd  h# 11 c, 1 c, 0 c, 0 c, 0 c, 0 c,
  54.  
  55. : skip-files  ( n -- error? )           \ Skips n file marks
  56.    ?write-eof
  57.    false is at-eof?                ( n ) 
  58.    skip-files-cmd 2 + 3c!          ( )
  59.    skip-files-cmd no-data-command  ( error? )
  60. ;
  61.  
  62. \ Asks the device its record length
  63. \ Also determines fixed or variable length
  64.  
  65. create block-limit-cmd  5 c, 0 c, 0 c, 0 c, 0 c, 0 c,
  66.  
  67. : 2c@  ( addr -- n )  1 +  -c@  c@              bwjoin  ;
  68.  
  69. : get-record-length  ( -- )
  70.    6  block-limit-cmd 6  short-data-command  if
  71.       d# 512   true                 ( blocksize fixed-len )
  72.    else                             ( buffer )
  73.       dup 1 + 3c@  swap 4 + 2c@     ( max-len min-len )
  74.       over =                        ( blocksize fixed-len? )
  75.    then                             ( blocksize fixed-len? )
  76.    is fixed-len?                    ( blocksize )
  77.  
  78.    dup parent-max-transfer u>  if   ( blocksize )
  79.       drop parent-max-transfer      ( blocksize' )
  80.    then                             ( blocksize )
  81.  
  82.    is /tapeblock                    ( )
  83. ;
  84.  
  85. true instance value first-install?      \ Used for rewind-on-first-open
  86.  
  87. \ Words to decode various interesting fields in the extended status buffer
  88. \ Used by actual-#blocks
  89.  
  90. \ Incorrect length
  91.  
  92. : ili?  ( statbuf -- flag )  2 + c@ h# 20 and  0<>  ;
  93.  
  94.  
  95. \ End of Media, End of File, or Blank Check
  96.  
  97. : eof?  ( statbuf -- flag )
  98.    dup 2 + c@ h# c0 and  0<>   swap 3 + c@ h# f and  8 =  or
  99. ;
  100.  
  101.  
  102. \ Difference between requested count and actual count
  103.  
  104. : residue  ( statbuf -- residue )  3 + 4c@  ;
  105.  
  106.  
  107. 0 instance value #requested  \ Local variable for r/w-some and actual-#blocks
  108.  
  109.  
  110. \ Decodes the status information returned by the SCSI command to
  111. \ determine the number of blocks actually tranferred.
  112.  
  113. : actual-#blocks  ( [[xstatbuf] hw-err? ] status -- #xfered flag )
  114.    if         \ Error                           ( true  |  xstatbuf false )
  115.       if      \ Hardware error; none tranferred ( )
  116.          0 false                                ( 0 false )
  117.       else    \ Decode status buffer            ( xstatbuf )
  118.          >r  #requested                         ( #requested ) ( r: xstatbuf )
  119.          r@ ili?  r@ eof? or  if                ( #requested ) ( r: xstatbuf )
  120.             r@ residue -                        ( #xfered )    ( r: xstatbuf )
  121.          then                                   ( #xfered )    ( r: xstatbuf )
  122.          r> eof?                                ( #xfered flag )
  123.       then
  124.    else       \ no error, #request = #xfered    ( )
  125.       #requested false                          ( #xfered flag )
  126.    then
  127.    is at-eof?
  128. ;
  129.  
  130.  
  131. \ Reads or writes at most "#blks" blocks, returning the actual number
  132. \ of blocks transferred, and an error indicator that is true if either a
  133. \ fatal error occurs or the end of a tape file is reached.
  134.  
  135. : r/w-some  ( addr #blks input? cmd -- actual# error? )
  136.    0 cb!  swap                     ( addr dir #blks )
  137.    fixed-len?  if                  ( addr dir #blks )
  138.  
  139.       \ If the tape has fixed length records, we multiply the
  140.       \ requested number of blocks by the record size.
  141.  
  142.       dup is #requested            ( addr dir #blks )
  143.       dup /tapeblock *  swap  1    ( addr dir #bytes cmd-cnt 1=fixed-len )
  144.  
  145.    else        \ variable length   ( addr dir #bytes )
  146.  
  147.       \ If the tape has variable length records, we transfer one record.
  148.  
  149.       drop /tapeblock              ( addr dir #bytes )
  150.       dup is #requested            ( addr dir #bytes )
  151.       dup 0                        ( addr dir #bytes cmd-cnt 0=variable-len )
  152.  
  153.    then                            ( addr dir #bytes cmd-cnt byte1 )
  154.  
  155.    1 cb!  cmdbuf 2 + 3c!           ( addr dir #bytes )
  156.    swap  cmdbuf 6  -1              ( dma-addr,len dir cmd-addr,len #retries)
  157.    retry-command  actual-#blocks   ( actual# )
  158. ;
  159.  
  160. \ Discards (for read) or flushes (for write) any bytes that are buffered by
  161. \ the deblocker
  162.  
  163. : flush-deblocker   ( -- )
  164.    deblocker close-package  init-deblocker drop
  165. ;
  166.  
  167. external
  168.  
  169.  
  170. \ The deblocker package calls max-transfer to determine an appropriate
  171. \ internal buffer size.
  172.  
  173. : max-transfer  ( -- n )
  174.    fixed-len?  if
  175.       \ Use the largest multiple of /tapeblock that is <= parent-max-transfer
  176.       parent-max-transfer  /tapeblock /   /tapeblock *
  177.    else
  178.       /tapeblock
  179.    then
  180. ;
  181.  
  182. \ The deblocker package calls block-size to determine an appropriate
  183. \ granularity for accesses.
  184.  
  185. : block-size ( -- n )
  186.    fixed-len?  if  /tapeblock  else  1  then
  187. ;
  188.  
  189. \ The deblocker uses read-blocks and write-blocks to access tape records.
  190. \ The assumption of sequential access is guaranteed because this is only
  191. \ called from the deblocker.  Since the SCSI tape package implements its
  192. \ own "seek" method, the deblocker seek method is never called, and the
  193. \ deblocker's internal position only changes sequentially.
  194.  
  195. : read-blocks  ( addr block# #blocks -- #read )
  196.    nip                                    ( addr #blocks )  \ Sequential access
  197.  
  198.    \ Don't read past a file mark
  199.    at-eof?  if  2drop 0  exit  then       ( addr #blocks )
  200.  
  201.    true 8 r/w-some                        ( #read )
  202. ;
  203.  
  204. : write-blocks  ( addr block# #blocks -- #read )
  205.    nip                                    ( addr #blocks )  \ Sequential access
  206.    true is written?                       ( addr #blocks )
  207.    false h# a r/w-some                    ( #written )
  208. ;
  209.  
  210.  
  211. \ Methods used by external clients
  212.  
  213. : read  ( addr len -- actual-len )  " read"  deblocker $call-method  ;
  214.  
  215. : write  ( addr len -- actual-len )
  216.    " write"  deblocker $call-method       ( actual-len )
  217.    flush-deblocker        \ Make the tape structure reflect the write pattern
  218. ;
  219.  
  220. : open  ( -- okay? )
  221.    my-unit " set-address" $call-parent
  222.  
  223.    \ It might be a good idea to do an inquiry here to determine the
  224.    \ device configuration, checking the result to see if the device
  225.    \ really is a tape.
  226.  
  227.    first-install?  if
  228.       rewind  if
  229.          ." Can't rewind tape" cr 
  230.          false exit
  231.       then
  232.       false is first-install?
  233.    then
  234.  
  235.    get-record-length
  236.  
  237.    init-deblocker       ( okay? )
  238. ;
  239.  
  240. : close  ( -- )
  241.    deblocker close-package
  242.    ?write-eof
  243. ;
  244.  
  245.  
  246. 0 value buf
  247. h# 200 constant /buf
  248.  
  249. \ It would be better to keep track of the current file number and
  250. \ just seek forward if the requested file number/position is greater
  251. \ than the current file number/position.  Taking care of end-of-file
  252. \ conditions would be tricky though.
  253.  
  254. : seek  ( byte# file# -- error? )
  255.  
  256.    flush-deblocker                            ( byte# file# )
  257.  
  258.    rewind      if  2drop true  exit  then     ( byte# file# )
  259.  
  260.    ?dup  if                                   ( byte# file# )
  261.       skip-files  if   drop true  exit  then  ( byte# )
  262.    then                                       ( byte# )
  263.  
  264.    ?dup  if                                   ( byte# )
  265.       /buf alloc-mem  is buf
  266.       begin  dup 0>  while                    ( #remaining )
  267.          buf  over /buf min  read             ( #remaining #read )
  268.          dup 0=  if  2drop  true exit  then   ( #remaining #read )
  269.          -                                    ( #remaining' )
  270.       repeat                                  ( 0 )
  271.       drop                                    ( )
  272.       buf /buf free-mem                       ( )
  273.    then                                       ( )
  274.  
  275.    false                                      ( no-error )
  276. ;
  277.  
  278. : load  ( loadaddr -- size )
  279.    my-args  dup  if                           ( loadaddr addr len )
  280.       $number  if                             ( loadaddr )
  281.          ." Invalid tape file number" cr      ( loadaddr )
  282.          drop 0 exit                          ( 0 )
  283.       then                                    ( loadaddr n )
  284.    else                                       ( loadaddr addr 0 )
  285.       nip                                     ( loadaddr 0 )
  286.    then                                       ( loadaddr file# )
  287.  
  288.    0 swap  seek  if                           ( loadaddr )
  289.        ." Can't select the requested tape file" cr
  290.        0 exit
  291.    then                                       ( loadaddr )
  292.  
  293.    \ Try to read the entire tape file.  We ask for a huge size
  294.    \ (almost 2 G Bytes), and let the deblocker take care of
  295.    \ breaking it up into manageable chunks.  The operation
  296.    \ will cease when a file mark is reached.
  297.  
  298.    h# 70000000 read                           ( size )
  299. ;
  300.    
  301. headers
  302.